home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 076-100 / disk_091 / adlcomp / routcomp.c < prev   
C/C++ Source or Header  |  1992-05-06  |  7KB  |  296 lines
  1.     /***************************************************************\
  2.     *                                *
  3.     *    routcomp.c - routines to compile ADL routines.        *
  4.     *    Copyright 1987 by Ross Cunniff.                *
  5.     *                                *
  6.     \***************************************************************/
  7.  
  8. #include <stdio.h>
  9.  
  10. #include "adltypes.h"
  11. #include "adlprog.h"
  12. #include "builtins.h"
  13. #include "adldef.h"
  14. #include "adlcomp.h"
  15.  
  16.  
  17. int16
  18.     inrout;            /* Are we inside a routine?    */
  19. extern int16
  20.     filenum;            /* Current file number        */
  21.  
  22. int16    getargs();    /* Forward declaration for daisy chaining    */
  23.  
  24.  
  25. char    *UNDEC_ID = "Undeclared identifier\n";
  26.  
  27.  
  28.     /***************************************************************\
  29.     *                                *
  30.     *    getglob() - generate the instruction for the '@glob'    *
  31.     *    construct.                        *
  32.     *                                *
  33.     \***************************************************************/
  34.  
  35. getglob()
  36. {
  37.     lexer();
  38.     newcode( PUSH, _GLOBAL );
  39.     if( t_type == VAR )
  40.     newcode( PUSH, t_val );
  41.     else if( t_type == LOCAL )
  42.     newcode( PUSHLOCL, t_val );
  43.     else if( t_type == ARGUMENT )
  44.     newcode( PUSHARG, t_val );
  45.     else if( t_type == UNDECLARED )
  46.     error( UNDEC_ID );
  47.     else
  48.     error( "Illegal '@'.\n" );
  49.     newcode( CALL, 2L );
  50. }
  51.  
  52.  
  53.     /***************************************************************\
  54.     *                                *
  55.     *    getpair() - generate code for the '[ mod noun ]'    *
  56.     *    construct.                        *
  57.     *                                *
  58.     \***************************************************************/
  59.  
  60. getpair()
  61. {
  62.     int16
  63.     getold();
  64.  
  65.     newcode( PUSH, getold( 0, 0 ) );
  66.     lexer();
  67.     if( t_type != ']' )
  68.     _ERR_FIX( BRACKET_EXPECTED, ']' );
  69. }
  70.  
  71.  
  72.     /***************************************************************\
  73.     *                                *
  74.     *    getexpr( t_read ) - generates code for an ADL routine    *
  75.     *    expression.  t_read is 0 if a token has not already    *
  76.     *    been read.                        *
  77.     *                                *
  78.     \***************************************************************/
  79.  
  80. getexpr( t_read )
  81. int16
  82.     t_read;
  83. {
  84.     if( !t_read )
  85.     lexer();
  86.     if( t_type == '(' )
  87.     getform();
  88.     else if( t_type == '@' )
  89.     getglob();
  90.     else if( t_type == '[' )
  91.     getpair();
  92.     else if( t_type == ARGUMENT )
  93.     newcode( PUSHARG, t_val );
  94.     else if( t_type == LOCAL )
  95.     newcode( PUSHLOCL, t_val );
  96.     else if( t_type == MYVAL )
  97.     newcode( PUSHME, 0 );
  98.     else if( t_type == NOUN) {
  99.     if( (t_val = noun_exists( 0, t_val )) < 0 )
  100.         error( ATTEMPT );
  101.     else
  102.         newcode( PUSH, t_val );
  103.     }
  104.     else if( (t_type >= MIN_LEGAL) && (t_type <= MAX_LEGAL) )
  105.     newcode( PUSH, t_val );
  106.     else if( t_type == UNDECLARED )
  107.     error( UNDEC_ID );
  108.     else
  109.     error( ILLEGAL_SYMBOL );
  110. }
  111.  
  112.  
  113.     /***************************************************************\
  114.     *                                *
  115.     *    getform() - get a routine form such as            *
  116.     *        (name arg arg...)                *
  117.     *    or                            *
  118.     *        (IF expr THEN arg arg ... ELSEIF ......)    *
  119.     *    or                            *
  120.     *        (WHILE expr DO arg arg ...)            *
  121.     *                                *
  122.     \***************************************************************/
  123.  
  124. getform()
  125. {
  126.     int16
  127.     t_save,
  128.     getargs();
  129.  
  130.     lexer();
  131.     if( t_type == IF )
  132.     getif();
  133.     else if( t_type == WHILE )
  134.     getwhile();
  135.     else {
  136.     t_save = t_type;
  137.     if( t_type == UNDECLARED )
  138.         _ERR_FIX( UNDEC_ID, ')' )    /* Note - no semicolon! */
  139.     else if( t_type == '(' )
  140.         getform();
  141.     else if( t_type == ARGUMENT )
  142.         newcode( PUSHARG, t_val );
  143.     else if( t_type == '@' )
  144.         getglob();
  145.     else
  146.         newcode( PUSH, t_val );
  147.     lexer();
  148.     if(    (t_save == '@') || (t_save == ROUTINE) ||
  149.         (t_save == '(') || (t_save == ARGUMENT) )
  150.         newcode( CALL, getargs() + 1 );
  151.     else
  152.         error( "Illegal function call.\n" );
  153.     }
  154. }
  155.  
  156.  
  157.     /***************************************************************\
  158.     *                                *
  159.     *    getwhile() - generate code for the WHILE form.        *
  160.     *                                *
  161.     \***************************************************************/
  162.  
  163. getwhile()
  164. {
  165.     address
  166.     topaddr,
  167.     breakaddr;
  168.  
  169.     topaddr = currcode();    /* Top of loop */
  170.     getexpr( 0 );        /* Conditional */
  171.  
  172.     breakaddr = newcode( JMPZ, 0 );    /* If 0 then exit loop */
  173.     newcode( POP, 0 );        /* Pop the condition code */
  174.  
  175.     lexer();
  176.     if( t_type != DO )
  177.     error( "'DO' expected in WHILE loop.\n" );
  178.  
  179.     getroutine( 0 );
  180.     if( t_type != ')' )
  181.     _ERR_FIX( RIGHT_EXPECTED, ')' );
  182.     newcode( POP, 0 );
  183.     newcode( JMP, topaddr );
  184.  
  185.     oldcode( breakaddr, JMPZ, currcode() );    /* Fix up the breakaddr */
  186. }
  187.  
  188.  
  189.     /***************************************************************\
  190.     *                                *
  191.     *    getif() - generate code for the IF...ELSEIF...ELSE form    *
  192.     *                                *
  193.     \***************************************************************/
  194.  
  195. getif()
  196. {
  197.     address
  198.     oldaddr,
  199.     breakaddr;
  200.  
  201.     getexpr( 0 );                /* Get the conditional */
  202.     oldaddr = newcode( JMPZ, 0 );        /* Save the cond. br. addr */
  203.  
  204.     lexer();                    /* Read the THEN */
  205.     if( t_type != THEN )
  206.     error( "'THEN' expected.\n" );
  207.  
  208.     newcode( POP, 0 );                /* Pop the condition */
  209.     getroutine( 0 );                /* Get the body of the IF */
  210.  
  211.     if( t_type == ')' ) {
  212.     /* We're done reading the IF statement */
  213.     oldcode( oldaddr, JMPZ, currcode() );    /* Fix up the IF jump */
  214.     }
  215.  
  216.     else {
  217.     /* There was an ELSE or ELSEIF somewhere */
  218.     breakaddr = newcode( JMP, 0 );        /* Skip the ELSE or ELSEIF */
  219.     oldcode( oldaddr, JMPZ, currcode() );    /* Fix up the IF jump */
  220.     newcode( POP, 0 );            /* Pop the condition code */
  221.  
  222.     if( t_type == ELSEIF ) {
  223.         /* This should be almost the same as an IF statement */
  224.         getif();        /* Recursively read the ELSEIF...ELSE */
  225.         oldcode( breakaddr, JMP, currcode() ); /* Fixup */
  226.     }
  227.  
  228.     else if( t_type == ELSE ) {
  229.         /* This is slightly different */
  230.         getroutine( 0 );            /* Get the ELSE body */
  231.         if( t_type != ')' )
  232.         _ERR_FIX( RIGHT_EXPECTED, ')' );
  233.         oldcode( breakaddr, JMP, currcode() );    /* Fixup */
  234.     }
  235.  
  236.     else
  237.         _ERR_FIX( ILLEGAL_SYMBOL, ')' );
  238.     }
  239. }
  240.  
  241.  
  242.     /***************************************************************\
  243.     *                                *
  244.     *    getargs() - generate code for a list of arguments to    *
  245.     *    a routine call.                        *
  246.     *                                *
  247.     \***************************************************************/
  248.  
  249. int16
  250. getargs()
  251. {
  252.     int16
  253.     temp = 0;    /* Number of arguments found */
  254.  
  255.     while( 1 ) {
  256.     if( t_type == ')' )
  257.         /* We're done reading arguments */
  258.         return temp;
  259.     getexpr( 1 );    /* Get an argument */
  260.     lexer();    /* Get the next token */
  261.     temp++;        /* Increment the number of args found */
  262.     }
  263. }
  264.  
  265.     /***************************************************************\
  266.     *                                *
  267.     *    getroutine( t_read ) - parse and generate code for    *
  268.     *    an ADL routine.                        *
  269.     *                                *
  270.     \***************************************************************/
  271.  
  272. getroutine( t_read )
  273. int16
  274.     t_read;
  275. {
  276.     int16
  277.     irsave;
  278.  
  279.     irsave = inrout;
  280.     if( !inrout ) {
  281.     inrout = 1;
  282.     emit_file();
  283.     }
  284.     if( !t_read )
  285.     lexer();
  286.     while( t_type == '(' ) {
  287.     getform();
  288.     lexer();
  289.     if( t_type == '(' )
  290.         newcode( POP, 0 );
  291.     }
  292.     inrout = irsave;
  293. }
  294.  
  295. /*** EOF routcomp.c ***/
  296.